perm filename ERRORX.LSP[RUT,LSP] blob
sn#343775 filedate 1978-03-22 generic text, type T, neo UTF8
(DECLARE (SPECIAL *NOPOINT BASE USERERRORX BRKEXP BRKTYPE BRKWHEN BRKCOMS BRKFN
BREAKMACROS %%MSGFLAG !VALUE %LOOKDPTH LASTPOS %%BKPOS %%CMDL
%PREVFN% L LAPLST %FROM %TO CHNGDFLG #%INDENT #%BKSAVE TRACE
BKPOS CATCH THROW ↑H)
(NOCALL EVALP GOFN EDBRK BKTRACE BKFIND BKTR BKTRV BKPRINVAL BKACT
CHNMX CHNM1 BKREAD ARGLIST %%MSGFLAG %%BKPOS %%CMDL %FROM %TO
CHNGDFLG)
(CALL %PRINFN)
(*FSUBR BKREAD))
(DEFPROP ERRORX
(LAMBDA (X)
(COND [(AND USERERRORX [USERERRORX X])]
[T (PROG (%%ERREX %%PREV LASTPOS)
(SETQ %%ERREX
(BREAK1 (COND [(SETQ LASTPOS
(NEXTEV (SUB1 (STKSRCH 'ERRORX
(SPDLPT)
NIL))))
(SETQ %%ERREX (SPDLRT LASTPOS))]
[T (ERR NIL)])
(COND [(CONSP %%ERREX)]
[(AND [SETQ %%PREV (NEXTEV (SUB1 LASTPOS))]
[NEQ (STKNAME %%PREV) '//BREAK1])]
[T (ERR NIL)])
(COND [(ATOM %%ERREX) %%ERREX] [(CAR %%ERREX)])
NIL
'ERRORX))
(OUTVAL LASTPOS %%ERREX))]))
EXPR)
(DEFPROP BREAK1
(LAMBDA (BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE)
{;; The #%BKSAVE is done in BREAK1 instead of /BREAK1 in case /BREAK1 is
restarted <typically via ↑C ↑B>; the EVAL is done to insure that an eval
blip appears on the stack <BREAK1 might be called from compiled code>;
Note that /BREAK1 looks for a BREAK1 eval blip immediately preceding the
/BREAK1 which won't be the case when BREAK1 is uncompiled so LASTPOS won't
be set correctly when debugging the ERRORX package⎇
(SETQ #%BKSAVE
(CONS (MCONS (PROMPT 58.) (INC NIL NIL) (OUTC NIL NIL)) #%BKSAVE))
(EVAL '(//BREAK1)))
EXPR)
(DEFPROP //BREAK1
(LAMBDA NIL
(PROG (LASTPOS %%EVALFLAG !VALUE %%MSGFLAG %%BKPOS %%CMDL)
(AND [SETQ LASTPOS
(STKSRCH (COND [(EQ BRKTYPE 'ERRORX) 'ERRORX] ['//BREAK1])
(SPDLPT)
NIL)]
[EQ (STKNAME (SETQ %%BKPOS (NEXTEV (SUB1 LASTPOS)))) 'BREAK1]
[SETQ LASTPOS %%BKPOS])
(SETQ %%BKPOS LASTPOS)
(SETQ BKPOS NIL)
(COND [(NULL BRKWHEN) (FROM?= BRKEXP)])
(SETQ LASTPOS (COND [(NEXTEV (SUB1 LASTPOS))] [LASTPOS]))
(SETQ %%CMDL (ADD1 LASTPOS))
UNMAC (COND [(SETQ %%CMDL (STKSRCH 'MACROEXPANSION %%CMDL NIL))
(UNMACEXPAND (SPDLRT %%CMDL))
(GO UNMAC)])
BRKLP (COND [BRKCOMS (AND [ATOM (SETQ %%CMDL (CAR BRKCOMS))]
[SETQ %%CMDL (NCONS %%CMDL)])
(SETQ BRKCOMS (CDR BRKCOMS))]
[T (INC NIL T)
(OUTC NIL T)
(PROMPT 58.)
(TALK)
(SETQ ↑H NIL) {; Clear ↑H interrupt flag⎇
(LINES 1.)
(COND [(NULL %%MSGFLAG)
(MSG BRKFN " Broken:" -1.)
(SETQ %%MSGFLAG T)])
(PROG (BASE *NOPOINT)
(SETQ BASE 10.)
(SETQ *NOPOINT T)
(PRINC (LENGTH #%BKSAVE)))
(COND [(ATOM (SETQ %%CMDL (ERRSET (LINEREAD) ERRORX)))
(GO BRKLP)]
[T (SETQ %%CMDL (CAR %%CMDL))])])
BKLP2 (AND %%MSGFLAG [LINES 0.])
(COND [(NULL %%CMDL) (GO BRKLP)])
(SELECTQ
[CAR %%CMDL]
[↑ (*RSETERX 1.) (ERR NIL)]
[↑↑ (*RSETERX (LENGTH #%BKSAVE)) (**TOP**)]
[BK (BKTRACE (BKREAD 512.) '(NIL T T T))]
[BKE (BKTRACE (BKREAD 512.) '(NIL NIL T T))]
[BKF (BKTRACE (BKREAD 512.) '(NIL NIL NIL T))]
[BKV (BKTRACE (BKREAD 512.) '(T T T T))]
[BKEV (BKTRACE (BKREAD 512.) '(T NIL T T))]
[BKFV (BKTRACE (BKREAD 512.) '(T NIL NIL T))]
[> (PROG (X Y Z)
(SETQ X (BKREAD))
(COND [(ATOM (SETQ Y (SPDLRT LASTPOS)))
(CHNM1 (COND [(SETQ Z (NEXTEV (SUB1 LASTPOS)))
(SPDLRT Z)])
Y
X)
(RPLACD (STKPTR LASTPOS) X)]
[(AND [RPLACA BRKEXP X]
[NOT (EQ (SETQ Z (BKREAD //BREAK1)) '//BREAK1)])
(RPLACD BRKEXP (CONS Z (CDR BRKEXP)))])
(FROM?= NIL))]
[GO (COND [%%EVALFLAG] [(EVALP BRKEXP) (GO BRKER)])
(LINES 0.)
(%PRINFN !VALUE)
(GO LEAVE)]
[OK (COND [%%EVALFLAG] [(EVALP BRKEXP) (GO BRKER)]) (GO LEAVE)]
[EVAL (COND [(EVALP BRKEXP) (GO BRKER)])
(AND %%MSGFLAG [PROGN (LINES 0.) (%PRINFN !VALUE)])
(SETQ %%EVALFLAG T)]
[EDIT (PRINC '"= ")
(COND [(& (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))) T)
(ERRSET (EDBRK) ERRORX)]
[T (GO BRKER)])]
[?= (?= (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))))]
[ARGS (MAPC (FUNCTION ARGPRINT) (ARGLIST BRKFN))]
[& (OR [& (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))) T] [GO BRKER])]
[RETURN (COND [(EVALP (SETQ BRKEXP
(PROG1 (BKREAD) (SETQ %%CMDL BRKEXP))))
(SETQ BRKEXP %%CMDL)
(GO BRKER)])
(GO LEAVE)]
[FROM?= (FROM?= (BKREAD))]
[EX (COND [(OR [NULL (CDR %%CMDL)]
[& (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))) NIL])
(FROM?= NIL)]
[T (GO BRKER)])]
[USE (USE)]
[TRACE (AND TRACE [OUTC (CDDAR #%BKSAVE) NIL])
(SETQ BKPOS T)
(BKPOS #%INDENT)
(PRINC '"Enter ")
(PRIN1 BRKFN)
(PRINC ':)
(SETQ #%INDENT (*PLUS #%INDENT 3.))]
[UNTRACE (SETQ LASTPOS %%BKPOS)
(SETQ BKPOS NIL)
(FROM?= (LIST '%UNTRACE BRKFN BRKEXP))]
[COND
[(ASSOC (CAR %%CMDL) BREAKMACROS)
(SETQ BRKCOMS
(APPEND
(PROG (TEMP)
(RETURN (COND [(AND [CAR (SETQ TEMP
(CDR (ASSOC (CAR %%CMDL)
BREAKMACROS)))]
[LITATOM (CAR TEMP)])
(SUBST (CDR %%CMDL) (CAR TEMP) (CDR TEMP))]
[T (SUBPAIR (CAR TEMP) (CDR %%CMDL) (CDR TEMP))
])))
BRKCOMS))
(GO BRKLP)]
[(AND [LITATOM (CAR %%CMDL)] [EQ (CHRVAL (CAR %%CMDL)) 62.])
(SETQ %%CMDL (AEXPLODE %%CMDL))
(RPLACD (CDR %%CMDL) (CONS 32. (CDDR %%CMDL)))
(COND [(CONSP (SETQ %%CMDL (ERRSET (READLIST %%CMDL) ERRORX)))
(SETQ %%CMDL (CAR %%CMDL))
(GO BKLP2)]
[T (GO BRKER)])]
[(ATOM (ERRSET (COND [%%MSGFLAG (%PRINFN (PROG1 (EVAL (CAR %%CMDL))
(LINES 0.)))]
[T (EVAL (CAR %%CMDL))])
ERRORX))
(GO BRKER)]])
(SETQ %%CMDL (CDR %%CMDL))
(GO BKLP2)
BRKER (SETQ BRKCOMS NIL)
(GO BRKLP)
LEAVE (SETQ LASTPOS %%BKPOS)
(COND [(ATOM BRKEXP)] [(GOFN (CAR BRKEXP)) (FROM?= BRKEXP)])
LEAV2 (*RSETERX 1.)
(RETURN !VALUE)))
EXPR)
(DEFPROP EVALP
(LAMBDA (#1)
((LAMBDA (#%BKSAVE) (*RSETERX 1.)) #%BKSAVE)
(COND [(AND [CONSP #1] [SETQ !VALUE (GOFN (CAR #1))])]
[T (SETQ !VALUE (ERRSET (EVAL #1) ERRORX))])
(INC NIL NIL)
(OUTC NIL NIL)
(PROMPT 58.)
(COND [(EQ !VALUE 'THROW)
(SETQ BRKEXP (LIST 'THROW (LIST 'QUOTE THROW) CATCH))
(SETQ !VALUE 'THROW)
NIL]
[(ATOM !VALUE) (PRINC '?) T]
[T (SETQ !VALUE (CAR !VALUE)) NIL]))
EXPR)
(DEFPROP GOFN
(LAMBDA (FN)
(AND [EQ FN 'BRKAPPLY] [SETQ FN BRKFN])
(COND [(MEMQ FN '(GO RETURN ERR THROW))]
[(SETQ FN (GET FN 'ALIAS)) (MEMQ (CDR FN) '(GO RETURN ERR THROW))]))
EXPR)
(DEFPROP PLEV (LAMBDA (X) (PRINLEV X %LOOKDPTH)) EXPR)
(DEFV %LOOKDPTH 6.)
(DEFPROP FROM?=
(LAMBDA (X)
(*RSETERX (STKCOUNT '//BREAK1 (SPDLPT) LASTPOS))
(COND [X (SPREVAL LASTPOS X)] [T (SPREDO LASTPOS)]))
EXPR)
(DEFPROP USE
(LAMBDA NIL
(PROG (%%X %%Y %%Z)
(SETQ %%X (BKREAD))
(COND [(EQ (BKREAD) 'FOR) (SETQ %%Y (BKREAD))]
[(PRINC '?) (SETQ %%CMDL '(NIL)) (RETURN T)])
(COND [(ATOM (SETQ %%Z (SPDLRT LASTPOS)))
(COND [(EQ %%Y %%Z)
(RPLACD (STKPTR LASTPOS) %%X)
(AND [EQ BRKEXP %%Z] [SETQ BRKEXP %%X])
(COND [(SETQ %%Z (NEXTEV (SUB1 LASTPOS)))
(SETQ %%Z (SPDLRT %%Z))]
[T (RETURN T)])]
[T (PRINC '?) (RETURN T)])])
(COND [(CHNM1 %%Z %%Y %%X)] [T (MSG 0. %%Y " not found in " %%Z)])))
EXPR)
(DEFPROP ?=
(LAMBDA (#COMS)
(PROG (#COM)
(COND [(NULL #COMS)
(MAPC (FUNCTION ARGPRINT) (ARGLIST (STKNAME LASTPOS)))
(RETURN T)])
LP (COND [(NUMBERP (SETQ #COM (CAR #COMS)))
(ARGPRINT (CAR (NTH (ARGLIST (STKNAME LASTPOS)) #COM)))]
[T (ARGPRINT #COM)])
(AND [SETQ #COMS (CDR #COMS)] [GO LP])))
EXPR)
(DEFPROP &
(LAMBDA (COMS FLAG)
(PROG (POS COM FORFLAG)
(COND [(NULL COMS)
(SETQ POS (COND [(NEXTEV (SUB1 %%BKPOS))] [%%BKPOS]))]
[(MEMQ (CAR COMS) '(& F)) (SETQ POS LASTPOS) (GO NEXT)]
[T (SETQ POS %%BKPOS)])
LP (COND [(NULL COMS)
(SETQ LASTPOS POS)
(AND FLAG [PRIN1 (STKNAME LASTPOS)])
(RETURN T)]
[(EQ (SETQ COM (CAR COMS)) '←) (SETQ FORFLAG T) (GO NEXT)])
(COND [(NULL (SETQ POS
(COND [(NUMBERP COM) (STKNTH COM POS)]
[(ATOM COM)
(PROG1 (STKSRCH COM POS FORFLAG)
(SETQ FORFLAG NIL))])))
(MSG COM 1.)
(PRINC '?)
(RETURN NIL)])
NEXT (SETQ COMS (CDR COMS))
(GO LP)))
EXPR)
(DEFPROP EDBRK
(LAMBDA NIL
(PROG (L POS EXPR)
(COND [(PATOM (SETQ L (SPDLRT (SETQ POS LASTPOS))))
(COND [(AND [SETQ POS (NEXTEV (SUB1 POS))]
[BKFIND (SETQ EXPR (SPDLRT POS))])
(SETQ EXPR
(EDITL (NCONS EXPR) (LIST 'F L 'UP) NIL NIL NIL))
(EDITL EXPR NIL NIL NIL NIL)
(RPLACD (STKPTR LASTPOS) (COND [EXPR (CAAR EXPR)]))]
[T (PRINC '"not editable.") (RETURN NIL)])]
[T (EDITE L NIL NIL)])
(COND [(EQ L BRKEXP) (SETQ BRKEXP (SPDLRT LASTPOS))])))
EXPR)
(DEFPROP *RSETERX
(LAMBDA (N)
(PROG NIL
(COND [(*LESS N 1.) (RETURN NIL)])
LP (COND [(EQ N 1.)
(ERRSET (PROGN (INC (CADAR #%BKSAVE) NIL)
(OUTC (CDDAR #%BKSAVE) NIL))
ERRORX)
(PROMPT (CAAR #%BKSAVE))
(SETQ #%BKSAVE (CDR #%BKSAVE))
(RETURN NIL)])
(SETQ #%BKSAVE (CDR #%BKSAVE))
(SETQ N (SUB1 N))
(GO LP)))
EXPR)
(DEFPROP BKTRACE
(LAMBDA (#M #ACTION)
(PROG (#SPD #NEXT %ACTION #NEXTEXPR)
(SETQ #SPD (OR [PREVEV (ADD1 LASTPOS)] LASTPOS))
(SETQ %PREVFN% NIL)
L1 (COND [(LESSP (SETQ #M (SUB1 #M)) 0.) (SETQ %PREVFN% NIL) (RETURN T)])
(SETQ #NEXT (FNDBRKPT (SETQ #SPD (SUB1 #SPD))))
(COND [(NULL #NEXT) (SETQ %PREVFN% NIL) (RETURN T)])
(SETQ %ACTION (BKACT (SETQ #NEXTEXPR (SPDLRT #NEXT)) NIL))
(COND [(AND [CAR #ACTION] [CAR %ACTION])
(BKTRV #SPD
#NEXT
(AND [CADR #ACTION] [CADR %ACTION])
(AND [CADDR #ACTION] [CADDR %ACTION])
(AND [CADDDR #ACTION] [CADDDR %ACTION]))]
[(AND [CADR #ACTION] [CADR %ACTION])
(BKTR #SPD #NEXT (AND [CADDR #ACTION] [CADDR %ACTION]))]
[(AND [CADDR #ACTION] [CADDR %ACTION])
(SETQ %PREVFN% (PRINTLEV #NEXTEXPR 3.))]
[(AND [CADDDR #ACTION] [CADDDR %ACTION] [CONSP #NEXTEXPR])
(PRINT (CAR #NEXTEXPR))]
[T (SETQ #M (ADD1 #M))])
(AND [NULL (BKACT #NEXTEXPR T)]
[NULL (CADR #ACTION)]
[SETQ #M (SUB1 #M)])
(SETQ #SPD #NEXT)
(GO L1)))
EXPR)
(DEFPROP FNDBRKPT
(LAMBDA (%SPD)
(PROG (%OLDSPD L %FUNAME)
(COND [(NULL (NEXTEV %SPD)) (RETURN NIL)])
(SETQ L (SPDLRT (SETQ %SPD (ADD1 %SPD))))
L1 (COND [(NULL (SETQ %SPD (NEXTEV (SUB1 (SETQ %OLDSPD %SPD)))))
(RETURN %OLDSPD)]
[(ATOM (SETQ %FUNAME (SPDLRT %SPD))) (RETURN %SPD)])
(COND [(BKFIND %FUNAME) (SETQ L %FUNAME) (GO L1)])
(RETURN %SPD)))
EXPR)
(DEFPROP BKFIND
(LAMBDA (X)
(PROG NIL
L1 (COND [(OR [EQ (CAR X) L] [AND [NOT (PATOM (CAR X))] [BKFIND (CAR X)]])
(RETURN T)])
(COND [(NOT (PATOM (SETQ X (CDR X)))) (GO L1)])))
EXPR)
(DEFPROP BKTR
(LAMBDA (%SPD %NEXT %ACT)
(PROG NIL
LP (SETQ %SPD (NEXTEV %SPD))
(AND [NULL %ACT] [EQ %SPD %NEXT] [RETURN NIL])
(SETQ %PREVFN% (PRINTLEV (SPDLRT %SPD) 3.))
(COND [(EQ %SPD %NEXT) (RETURN NIL)])
(SETQ %SPD (SUB1 %SPD))
(GO LP)))
EXPR)
(DEFPROP BKTRV
(LAMBDA (%SPD %NEXT %ACT1 %ACT2 %ACT3)
(PROG (#ACTION)
(SETQ %SPD (ADD1 %SPD))
LP1 (SETQ %SPD (SUB1 %SPD))
(COND [(NOT (PATOM (SPDLFT %SPD))) (GO LP3)] [(SPDLFT %SPD) (GO LP1)])
(SETQ #ACTION (CDR (BKACT (SPDLRT %SPD) NIL)))
(COND [(OR [AND %ACT1 [CAR #ACTION] [NEQ %SPD %NEXT]]
[AND %ACT2 [CADR #ACTION] [EQ %SPD %NEXT]])
(SETQ %PREVFN% (PRINTLEV (SPDLRT %SPD) 3.))]
[(AND %ACT3 [CADDR #ACTION] [CONSP (SPDLRT %SPD)] [EQ %SPD %NEXT])
(PRINT (CAR (SPDLRT %SPD)))])
(COND [(EQ %SPD %NEXT) (RETURN NIL)] [T (GO LP1)])
LP3 (TERPRI)
(PRINC '" ")
(BKPRINVAL %SPD)
(GO LP1)))
EXPR)
(DEFPROP BKPRINVAL
(LAMBDA (%SPD)
(PROG (NAM SPEC)
(PRINC (COND [(CAR (SETQ SPEC (SPDLFT %SPD)))]
[(SETQ NAM (ASSOC SPEC LAPLST)) (CDR NAM)]
[T '?]))
(PRINC '" = ")
(PRINLEV (COND [(EQ (SETQ %SPD (EVALV (OR [CAR SPEC] SPEC) (ADD1 %SPD)))
(UNBOUND))
'UNBOUND]
[%SPD])
3.)))
EXPR)
(DEFPROP BKACT
(LAMBDA (#NEXT #FLAG)
(COND [(OR [PATOM #NEXT]
[NOT (LITATOM (CAR #NEXT))]
[NULL (SETQ #NEXT (GET (CAR #NEXT) 'ERXACTION))])
'(T T T T)]
[(CONSP #NEXT) #NEXT]
[#FLAG (PRINTC #NEXT) NIL]
[T '(NIL T NIL NIL)]))
EXPR)
(DEFPROP CHNMX
(LAMBDA (%IN)
(PROG NIL
LP (COND [(PATOM %IN) (RETURN %IN)]
[(EQUAL (CAR %IN) %FROM) (RPLACA %IN %TO) (SETQ CHNGDFLG T)]
[(CHNMX (CAR %IN))])
(SETQ %IN (CDR %IN))
(GO LP)))
EXPR)
(DEFPROP CHNM1
(LAMBDA (%IN %FROM %TO)
(PROG (CHNGDFLG) (CHNMX %IN) (RETURN (AND CHNGDFLG %IN))))
EXPR)
(DEFPROP BKREAD
(LAMBDA (X)
(COND [(AND %%CMDL [CDR %%CMDL])
(PROG1 (CADR %%CMDL) (SETQ %%CMDL (CDR %%CMDL)))]
[X (CAR X)]))
FEXPR)
(DEFPROP BKPOS
(LAMBDA (COL)
(PROG (WHERE)
(SETQ COL (REMAINDER COL (*DIF (LINELENGTH NIL) 24.)))
(LINES 0.)
(SETQ WHERE 1.)
LP (COND [(GREATERP WHERE COL) (RETURN COL)]
[(PRINC '"! ") (SETQ WHERE (*PLUS WHERE 3.)) (GO LP)])))
EXPR)
(DEFV BKPOS NIL)
(DEFPROP %UNTRACE
(LAMBDA (%L)
(PROG (CH VAL GOFL)
(OR [SETQ GOFL (GOFN (CAR %L))]
[SETQ VAL (ERRSET (EVAL (CADR %L)) ERRORX)])
(AND [NULL TRACE] [SETQ CH (OUTC NIL NIL)])
(BKPOS (SETQ #%INDENT (*DIF #%INDENT 3.)))
(PRIN1 (CAR %L))
(PRINC '" = ")
(COND [(ATOM VAL) (PRINC '?)] [T (%PRINFN (CAR VAL))])
(AND [NULL TRACE] [OUTC CH NIL])
(COND [GOFL (EVAL (CADR %L))]
[(ATOM VAL) (ERR VAL)]
[T (RETURN (CAR VAL))])))
FEXPR)
(DEFV TRACE NIL)
(DEFPROP ARGLIST
(LAMBDA (#FUNC)
(COND [(SETQ #FUNC (GETL #FUNC '(EXPR FEXPR MACRO)))
(COND [(AND [SETQ #FUNC (CADADR #FUNC)] [ATOM #FUNC])
(EVAL (LIST 'LXPD #FUNC) (PREVEV (ADD1 LASTPOS)))]
[#FUNC])]
[T (MSG 0. "Arguments not found.") NIL]))
EXPR)
(DEFPROP LXPD
(LAMBDA (NUMARGS)
(PROG (A)
LP (COND [(ZEROP NUMARGS) (RETURN A)]
[(SETQ A (CONS (LIST 'ARG NUMARGS) A))
(SETQ NUMARGS (SUB1 NUMARGS))
(GO LP)])))
EXPR)
(DEFPROP PREVEV
(LAMBDA (#POS)
(PROG (#TOP)
(SETQ #TOP (SPDLPT))
LP (COND [(GREATERP #POS #TOP) (RETURN NIL)]
[(SPDLFT #POS) (SETQ #POS (ADD1 #POS)) (GO LP)]
[(RETURN #POS)])))
EXPR)
(DEFPROP STKNAME
(LAMBDA (#POS)
(COND [(NULL #POS) NIL]
[(SPDLFT #POS) NIL]
[(ATOM (SETQ #POS (SPDLRT #POS))) #POS]
[(CAR #POS)]))
EXPR)
(DEFPROP STKNTH
(LAMBDA (#N #POS)
(PROG (#FLAG)
(COND [(MINUSP #N) (SETQ #N (MINUS #N)) (SETQ #FLAG T)])
LP (COND [(OR [NULL #POS] [ZEROP #N]) (RETURN #POS)]
[#FLAG (SETQ #POS (NEXTEV (SUB1 #POS)))]
[(SETQ #POS (PREVEV (ADD1 #POS)))])
(SETQ #N (SUB1 #N))
(GO LP)))
EXPR)
(DEFPROP STKSRCH
(LAMBDA (#NAME #POS #FLAG)
(PROG NIL
(COND [(NOT (NUMBERP #POS)) (RETURN #POS)])
LP (COND [#FLAG (SETQ #POS (PREVEV (ADD1 #POS)))]
[(SETQ #POS (NEXTEV (SUB1 #POS)))])
(COND [(OR [NULL #POS] [EQ (STKNAME #POS) #NAME]) (RETURN #POS)])
(GO LP)))
EXPR)
(DEFPROP STKCOUNT
(LAMBDA (#NAME #P #PEND)
(PROG (#C)
(SETQ #C 0.)
LP (COND [(OR [NULL #P]
[NULL (SETQ #P (NEXTEV (SUB1 #P)))]
[GREATERP #PEND #P])
(RETURN #C)]
[(EQ #NAME (STKNAME #P)) (SETQ #C (ADD1 #C))])
(GO LP)))
EXPR)
(DEFPROP ARGPRINT
(LAMBDA (X)
(COND
[X (COND [BKPOS (BKPOS #%INDENT)] [T (LINES 0.)])
(PRINC '" ")
(PRINLEV X 1.)
(PRINC '" = ")
(ERRSET (%PRINFN
(COND [(EQ (SETQ X
(COND [(ATOM X)
(EVALV X (PREVEV (ADD1 LASTPOS)))]
[(EVAL X (PREVEV (ADD1 LASTPOS)))]))
(UNBOUND))
'UNBOUND]
[X]))
ERRORX)]))
EXPR)
(DEFPROP BREAKMACROS
(NIL (-> X (> . X)) (F X (& . X)) (FIX X (EDIT . X) (FROM?= NIL)))
VALUE)
(DEFV %PRINFN PLEV)
(DEFV USERERRORX NIL)
(DEFPROP ERRORX (NIL NIL NIL NIL) ERXACTION)
(DEFPROP BREAK1 (NIL NIL NIL NIL) ERXACTION)
(DEFPROP //BREAK1 **BREAK** ERXACTION)
(DEFPROP BRKAPPLY (NIL NIL NIL NIL) ERXACTION)
(NOCOMPILE
(DEFV ERRORXFNS ((DECLARE (SPECIAL *NOPOINT BASE USERERRORX BRKEXP BRKTYPE
BRKWHEN BRKCOMS BRKFN BREAKMACROS %%MSGFLAG !VALUE %LOOKDPTH
LASTPOS %%BKPOS %%CMDL %PREVFN% L LAPLST %FROM %TO CHNGDFLG
#%INDENT #%BKSAVE TRACE BKPOS CATCH THROW ↑H) (NOCALL EVALP
GOFN EDBRK BKTRACE BKFIND BKTR BKTRV BKPRINVAL BKACT CHNMX
CHNM1 BKREAD ARGLIST %%MSGFLAG %%BKPOS %%CMDL %FROM %TO
CHNGDFLG) (CALL %PRINFN) (*FSUBR BKREAD)) ERRORX BREAK1
//BREAK1 EVALP GOFN PLEV (V: %LOOKDPTH) FROM?= USE ?= &
EDBRK *RSETERX BKTRACE FNDBRKPT BKFIND BKTR BKTRV BKPRINVAL
BKACT CHNMX CHNM1 BKREAD BKPOS %UNTRACE (V: (TRACE NIL))
ARGLIST LXPD PREVEV STKNAME STKNTH STKSRCH STKCOUNT ARGPRINT
(P: (VALUE) BREAKMACROS) (V: %PRINFN (USERERRORX NIL))
(P: (ERXACTION) ERRORX BREAK1 //BREAK1 BRKAPPLY)))
)